perm filename FILZ.F4[TMP,LCS] blob sn#136271 filedate 1974-12-17 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		SUBROUTINE FILLER(Q,R,NE,M,LP,IT,LD,LS)
C00007 ENDMK
CāŠ—;
	SUBROUTINE FILLER(Q,R,NE,M,LP,IT,LD,LS)
	DIMENSION Q(1),R(1),NE(1)
	KK=NE(1)
	KJ=2
	DO 4 K=2,KK
	IF(NE(K).NE.3)GO TO 11
	NE(K)=-1
	KJ=K+1
	GO TO 4
11	NE(K)=0
4	CONTINUE
	RLFT=10000
	RT=-10000
	B=RT
	DO 12 K=1,KK
	H=IFIX(Q(K))
	IF(H.LT.RLFT)RLFT=H
	IF(H.GT.RT)RT=H
	IF(H.EQ.B)NE(K)=-1
	B=H
	Q(K)=H
12	R(K)=IFIX(R(K))
	NE(KK+1)=-1
	LRT=RT
	JA=3
124	LEFT=RLFT
51	J=LEFT
42	RJ=J+.001
	JCONT=0
CC	JN=J
	LEFT=J
	JJ=-1
	ALT=-10000.
200	DO 45 L=2,KK
	IF(NE(L).NE.0)GO TO 45
	IF(MISS(L,RJ,Q))GO TO 45
	H=HGHT(L,RJ,Q,R)
	IF(H.LT.ALT)GO TO 45
	ALT=H
	JJ=L
45	CONTINUE
	IF(JJ)GO TO 43
	JCONT=-1
	LEFT=J
46	JA=3
	JORD=-1
52	KN=Q(JJ)
	KL=Q(JJ-1)
	IF(KN.LT.KL)KN=KL
50	I=J
102	RJ=I+.01
	ALT=HGHT(JJ,RJ,Q,R)
	B=-10000
	JK=-1
	XALT=ALT+.001
	ZALT=ALT
400	DO 47 L=2,KK
	IF(L.EQ.JJ.OR.MISS(L,RJ,Q).OR.NE(L).LT.0)GO TO 47
	H=HGHT(L,RJ,Q,R)
	IF(H.GT.XALT)GO TO 47
	IF(H.LE.B)GO TO 47
	B=H
	JK=L
47	CONTINUE
	IF(JK)GO TO 48
	ALT=ALT-1
300	IF(ZALT-B.GT..001.OR.I.NE.J)GO TO 59
	JX=Q(JK)
	IF(JX.GT.KN)GO TO 60
	JX=Q(JK-1)
	IF(JX.LT.KN)GO TO 59
60	L=JJ
	JJ=JK
	JK=L
	KN=JX
59	B=B+1
	IF(JORD)GO TO 103
	H=B
	B=ALT
	ALT=H
	IF(JK.NE.NK.AND.ABS(ALT-B).GT.5.)JA=3
103	CALL LINES(RJ,ALT,JA,LP,IT,LS,LD)
100	I2=2
	CALL LINES(RJ,B,I2,LP,IT,LS,LD)
	NK=JK
	JORD=-JORD
	NE(JK)=1
	NE(JJ)=-1
	JA=2
	I=I+M
	IF(I.LT.KN)GO TO 102
	L=1
	IF(KN.EQ.KL)L=-1
	JJ=JJ+L
	J=0
	IF(L)J=-1
	IF(KN+M.GT.Q(JJ+J).OR.JJ.GT.KK.OR.NE(JJ).NE.0)GO TO 124
	J=I
	GO TO 52
48	JA=3
43	J=LEFT+M
	IF(J.LE.LRT)GO TO 42
	IF(JCONT)GO TO 51
	END

	FUNCTION HGHT(J,A,Q,R)
	DIMENSION Q(1),R(1)
	B=R(J-1)
	D=Q(J-1)
	F=Q(J)
	HGHT=((R(J)-B)*(A-D))/(F-D)+B
	IF(F.EQ.D)HGHT=B
	END

	FUNCTION MISS(J,A,Q)
	DIMENSION Q(1)
	B=Q(J)
	C=Q(J-1)
	MISS=-1
	IF((A.LT.C.AND.A.GT.B).OR.(A.LT.B.AND.A.GT.C))MISS=0
	END